{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
----------------------------------------------------------------
--                                                            --
-- Module      :  LLVM.Code.Types                             --
-- License     :  GPL3                                        --
-- Mantainer   :  Mikhail Belyaev                             --
--                                                            --
----------------------------------------------------------------
module LLVM.Code.Shared where

import Data.Generics(Typeable, Data)
import Data.List (genericIndex, genericLength)

import LLVM.Util

-- index into types
newtype TypeIndex =
    TypeIndex { tiToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)
-- index into values
newtype ValIndex =
    ValIndex { viToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)
-- index into basic blocks
newtype BBIndex =
    BBIndex { biToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)
-- index into code sections
newtype SectionIndex =
    SectionIndex { siToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)
-- index into garbage collectors
newtype GCIndex =
    GCIndex { giToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)
-- index into parameter attributes
newtype ParamAttrIndex =
    ParamAttrIndex { paiToInteger :: Integer } deriving (Show,Eq,Ord,Num,Real,Enum,Integral,Typeable,Data)

-- Binary operation opcodes
--     BINOP_ADD  =  0,
--     BINOP_SUB  =  1,
--     BINOP_MUL  =  2,
--     BINOP_UDIV =  3,
--     BINOP_SDIV =  4,    // overloaded for FP
--     BINOP_UREM =  5,
--     BINOP_SREM =  6,    // overloaded for FP
--     BINOP_SHL  =  7,
--     BINOP_LSHR =  8,
--     BINOP_ASHR =  9,
--     BINOP_AND  = 10,
--     BINOP_OR   = 11,
--     BINOP_XOR  = 12
data BinOpcode = BinOpAdd | BinOpSub | BinOpMul | BinOpUDiv | BinOpSDiv | BinOpURem | BinOpSRem |
                    BinOpShl | BinOpLShr | BinOpAShr | BinOpAnd | BinOpOr | BinOpXor
                    deriving (Eq,Show,Bounded,Enum,Typeable,Data)
instance IntegerPartiallyCompatible BinOpcode where
    icToInteger = beToInt
    integerToIC = beFromIntSafe
-- Casting operation opcodes
--     CAST_TRUNC    =  0,
--     CAST_ZEXT     =  1,
--     CAST_SEXT     =  2,
--     CAST_FPTOUI   =  3,
--     CAST_FPTOSI   =  4,
--     CAST_UITOFP   =  5,
--     CAST_SITOFP   =  6,
--     CAST_FPTRUNC  =  7,
--     CAST_FPEXT    =  8,
--     CAST_PTRTOINT =  9,
--     CAST_INTTOPTR = 10,
--     CAST_BITCAST  = 11
data CastOpcode = Truncate | ZeroExt | SignExt | FloatToUnsigned | FloatToSigned | UnsignedToFloat |
                    SignedToFloat | FloatTruncate | FloatExt | PtrToInt | IntToPtr | BitCast
                    deriving (Eq,Show,Bounded,Enum,Typeable,Data)
instance IntegerPartiallyCompatible CastOpcode where
    icToInteger = beToInt
    integerToIC = beFromIntSafe
-- CMP opcodes
--     FCMP_FALSE =  0,  ///< 0 0 0 0    Always false (always folded)
--     FCMP_OEQ   =  1,  ///< 0 0 0 1    True if ordered and equal
--     FCMP_OGT   =  2,  ///< 0 0 1 0    True if ordered and greater than
--     FCMP_OGE   =  3,  ///< 0 0 1 1    True if ordered and greater than or equal
--     FCMP_OLT   =  4,  ///< 0 1 0 0    True if ordered and less than
--     FCMP_OLE   =  5,  ///< 0 1 0 1    True if ordered and less than or equal
--     FCMP_ONE   =  6,  ///< 0 1 1 0    True if ordered and operands are unequal
--     FCMP_ORD   =  7,  ///< 0 1 1 1    True if ordered (no nans)
--     FCMP_UNO   =  8,  ///< 1 0 0 0    True if unordered: isnan(X) | isnan(Y)
--     FCMP_UEQ   =  9,  ///< 1 0 0 1    True if unordered or equal
--     FCMP_UGT   = 10,  ///< 1 0 1 0    True if unordered or greater than
--     FCMP_UGE   = 11,  ///< 1 0 1 1    True if unordered, greater than, or equal
--     FCMP_ULT   = 12,  ///< 1 1 0 0    True if unordered or less than
--     FCMP_ULE   = 13,  ///< 1 1 0 1    True if unordered, less than, or equal
--     FCMP_UNE   = 14,  ///< 1 1 1 0    True if unordered or not equal
--     FCMP_TRUE  = 15,  ///< 1 1 1 1    Always true (always folded)
--     FIRST_FCMP_PREDICATE = FCMP_FALSE,
--     LAST_FCMP_PREDICATE = FCMP_TRUE,
--     BAD_FCMP_PREDICATE = FCMP_TRUE + 1,
--     ICMP_EQ    = 32,  ///< equal
--     ICMP_NE    = 33,  ///< not equal
--     ICMP_UGT   = 34,  ///< unsigned greater than
--     ICMP_UGE   = 35,  ///< unsigned greater or equal
--     ICMP_ULT   = 36,  ///< unsigned less than
--     ICMP_ULE   = 37,  ///< unsigned less or equal
--     ICMP_SGT   = 38,  ///< signed greater than
--     ICMP_SGE   = 39,  ///< signed greater or equal
--     ICMP_SLT   = 40,  ///< signed less than
--     ICMP_SLE   = 41,  ///< signed less or equal
--     FIRST_ICMP_PREDICATE = ICMP_EQ,
--     LAST_ICMP_PREDICATE = ICMP_SLE,
--     BAD_ICMP_PREDICATE = ICMP_SLE + 1


data FCmpOpcode = FCmpFalse | FCmpOEQ | FCmpOGT | FCmpOGE | FCmpOLT | FCmpOLE | FCmpONE | FCmpORD |
                    FCmpUEQ | FCmpUGT | FCmpUGE | FCmpULT | FCmpULE | FCmpUNE | FCmpTrue | FCmpBad
                    deriving (Bounded, Enum, Show, Eq, Typeable, Data)
instance IntegerPartiallyCompatible FCmpOpcode where
    icToInteger = beToInt
    integerToIC = beFromIntSafe

data ICmpOpcode = ICmpEQ | ICmpNE | ICmpUGT | ICmpUGE | ICmpULT | ICmpULE |
                          ICmpSGT | ICmpSGE | ICmpSLT | ICmpSLE | ICmpBad
                          deriving (Bounded, Enum, Show, Eq, Typeable, Data)
instance IntegerPartiallyCompatible ICmpOpcode where
    icToInteger a = beToInt a + 32
    integerToIC i = beFromIntSafe (i-32)

data CmpOpcode = FloatCmp FCmpOpcode | IntegerCmp ICmpOpcode  deriving (Show,Eq,Typeable,Data)
instance IntegerPartiallyCompatible CmpOpcode where
    icToInteger (FloatCmp fx) = icToInteger fx
    icToInteger (IntegerCmp ix) = icToInteger ix
    integerToIC i | i < 32 = fmap FloatCmp $ integerToIC i
                  | i >= 32 = fmap IntegerCmp $ integerToIC i


cmpFromInteger :: Integer -> Maybe CmpOpcode
cmpFromInteger = integerToIC

data LinkageType = External | Weak | Appending | Internal | LinkOnce | DllImport | DllExport |
                    ExternWeak | Common | Private | WeakOdr | LinkOnceOdr |
                     ExternallyAvailable | LinkerPrivate deriving (Bounded, Enum, Show, Eq, Typeable, Data)
instance IntegerPartiallyCompatible LinkageType where
    icToInteger = beToInt
    integerToIC = beFromIntSafe

data VisibilityType = DefaultVis | HiddenVis | ProtectedVis deriving (Bounded, Enum, Show, Eq, Typeable, Data)
instance IntegerPartiallyCompatible VisibilityType where
    icToInteger = beToInt
    integerToIC = beFromIntSafe

data CallingConv = CCC | FastCC | ColdCC | X86StdCallCC | X86FastCallCC
                    | ArmAPCSCC | ArmAAPCSCC | ArmAAPCSVFPCC deriving (Bounded, Enum, Show, Eq, Typeable, Data)
instance IntegerPartiallyCompatible CallingConv where
    icToInteger = beToInt
    integerToIC = beFromIntSafe

ltFromInteger :: Integer -> Maybe LinkageType
ltFromInteger = integerToIC

vtFromInteger :: Integer -> Maybe VisibilityType
vtFromInteger = integerToIC

